perm filename PT2.F4[NEW,LCS]2 blob sn#330396 filedate 1978-01-24 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE PT2
C00022 ENDMK
CāŠ—;
	SUBROUTINE PT2
	DIMENSION BARS(1),JBAR(1),JRN(1),MBAR(1),JTRN(1),PGTRN(1)
	1,IBAR(100)
	COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
	1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 /MNX/MIN,MAX,JT
	COMMON /SF/KL,RT,KP,SIZE,NAMX /IPG/IPG,JPG,BRACK(0/7),
	1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7) /RSIG/RSIG(0/7)
	1 /KBAR/KBAR(1) /RSP/KNM(20),ENDLN,N,NAME,NMPG,T
	COMMON RS,JA,RA,R,RB,RQ(15),KQ,NQ,JQ,JJQ,KBQ,NAQ /KNUM/KNUM
	1 /STF/RSTFAC(0/7),RSTJ2 /IVV/IV(1) /ITX/ITX(18)
	COMMON /POSI/STFF(0/7),JJ2,JPQ /LLL/L,ITRANS,I,RXQ,XSIG
	1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(200)
	1/JLINE/JLINE,SIZX /BRJ/JTOT,TURN,NB,DSK,PGLNTH
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
     1,(R8,RQ(6)),(R9,RQ(7)),(JRN,RN),(MBAR,RN(1000)),(KA,KBAR(1025))
	1,(K,KBAR(1027)),(JTRN,Q),(J,KBAR(1026)),(PGTRN,KBAR(516))
	1,(LCNT,IV(45)),(NDPY,IV(46)),(TOT,KBAR(2)),(JBAR,BARS,KBAR(4))
	1,(IBAR,Q(3000))
	DATA JLINE/200/,HX/2./,ITX/'EF-','E-','F','GF','G','AF','A',
	1 'BF','B',0,'DF','D','EF','E','F+','BBF','O-','O+'/,
	1 SLSP/11.0/,DIV/4./,PGLNTH/10.0/
	INTEGER DSK
C  O- = OCTAVE DOWN, O+ =OCTAVE UP.   OR 1/2 STEP NUMS. MAY BE USED.
C  JLINE=BASIC LINE LENGTH FAC.
C  HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
C  TRNSP'S ALL
145	FORMAT(F,3I)
	IF(NAMX.NE.0)GO TO 2000
	CALL GETEXT('BARS','PAG')
	CALL EXTIN(KBAR,1024)
C  STAFF NAMES BEGIN IN KBAR(508)  [STFNM(0)7]
	CALL EXTIN(RSTFAC,128)
2000	TYPE 144,RSTJ2
144	FORMAT(' STAFF SIZE='F4.2,'  CHANGE TO '$)
	ACCEPT 145,SIZE,DSK
C  TYPE 2ND NUM TO WRITE BARS/LINE DATA ON DSK FILE FOR21.DAT
	IF(DSK.NE.0)DSK=-1
	XSIG=0
	IF(IPG)GO TO 2001
C  IF NOT PARTS, INDICATE 1ST PAGE NUM (TO START PAGE NUMS BEYOND 1)
	TYPE 2002
2002	FORMAT(' FIRST PAGE NUMBER(0=1) AND PAGE LENGTH(0=10) -- '$)
	ACCEPT 111,KNUM,K
	IF(K.NE.0)PGLNTH=K
2001	TYPE 304
304	FORMAT(' TRANSP.= '$)
	ACCEPT 2101,ITRANS
	IF(ITRANS.GT.-20)GO TO 1101
2101	FORMAT(A3)
C  NEXT FOR LETTER NAMES 
	DO 3101 K=1,18
3101	IF(ITRANS.EQ.ITX(K))GO TO 4101
5101	TYPE 240
	GO TO 2000
240	FORMAT(' THIS TRANSP NOT OFFERED')
1101	REREAD 111,ITRANS
	IF(ITRANS.EQ.0)GO TO 1304
	ITRANS=10-ITRANS
	IF(ITRANS.EQ.22)ITRANS=17
C FOR DOWN OCT.
	IF(ITRANS.GT.0)GO TO 1304
	IF(ITRANS.EQ.-2)ITRANS=18
C  -2 NOW = UP OCT.
	GO TO 1304
	
4101	ITRANS=K
1304	IF(SIZE.EQ.0)SIZE=RSTJ2
	SIZX=SIZE
	SIZE=SIZE/RSTJ2 
CCC	IF(TURN.EQ.0)TURN=1000.
101	JTOT=0
C  ABOVE ASSUMES FIRST LINE ALWAYS HAS A CLEF.
	DO 22 K=1,KT
	JJ=BARS(K)*SIZX+.5
	JBAR(K)=JJ
22	JTOT=JTOT+JJ
33	IF(RSTJ2.EQ.0)RSTJ2=1 
	IF(JPG.EQ.0)JPG=1
	RA=JPG*SIZX
CC	RA=JPG*SIZE*RSTJ2
	MPG=PGLNTH/RA
C  MPG=NUM OF BRACES PER PAGE.  PGLNTH=10 OR 13
	LPG=JPG
	RA=0
90	FORMAT(' TOTAL BAR LINES='I3)
91	FORMAT(' NUMBER OF BARS PER LINE')
	
	NPG=MPG
	LTOT=JTOT
	NB=1
CXX	JT=TOT*RPG
CC	JT=TOT*SIZE
	JT=JTOT/JLINE+.5
C  USE JLINE (200 FOR NOW) AS SUGGESTED LINE LENGTH)
609	TYPE 2003
2003	FORMAT(' FIND PAGE TURNS?  '$)
	ACCEPT 2101,K
	TURN=1000.
	KPG=0
	IF(K.NE.'Y')GO TO 140
	CALL FNDTRN(RPG,PGTRN,JBAR,IBAR,KT,KB)
	IF(IBAR(1).NE.0)GO TO 119

140	TYPE 90,KT
	TYPE 91
	KPG=0
16	CALL BRJUGL(JBAR(1),KT,NBAR(1),MBAR(1),JRN(1),PGTRN(1)
	1,JTRN(1))
	
	RPG=JT
	RPG=RPG/MPG
605	TYPE 604,RPG,JT,KT
	IF(DSK)WRITE(21,604)RPG,JT,KT
	TURN=1000.
	NB=1
610	TYPE 608
604	FORMAT(F7.2,' PAGES',/,I4,' LINES',I6,' BARS')
608	FORMAT(/' TYPE LAYOUT NUMBERS(-1=HELP)-- '$)

C FOR 'T' TYPE X Y FOR X PAGES, Y LINES PER PAGE.
	KKT=0
	KA=0
	K=JT
	ACCEPT 145,T,N,KL
C   TYPE 0,n  TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
	IF(T)GO TO 700
C GO FOR HELP

	IF(KL.NE.0)GO TO 110
C NO MORE THAN 50 NUMS, INCLUDING 0S (FOR PAGE MARKS)
	IF(T.NE.0)GO TO 115
	REREAD 306,T,SPG
	GO TO 11
306	FORMAT(2F)
115	JT=T
	MPG=NPG
CC	IF(T.EQ.JT)GO TO 210
CC	MPG=(T-JT)*100.+.5
	IF(N.GT.100)GO TO 110
	IF(N.EQ.0)GO TO 16
C N=0 MEANS T= NUM OF LINES DESIRED.
	MPG=N
C MPG=LINES PER PAGE, JT=TOTAL NUM OF BARS
	KPG=MPG
 	JT=JT*MPG
	IF(JT.LE.KT)GO TO 16 
C CATCHES REQUEST FOR TOO MANY BARS.
	JT=K
606	TYPE 607
	GO TO 605
607	FORMAT(' WRONG NUMBER OF BARS')

111	FORMAT(50I)
110	REREAD 111,NBAR
	IF(NBAR(2).LT.100)GO TO 911
C NEXT FOR BARS PER PAGE SYSTEM
	DO 118 KB=1,100
	KP=NBAR(KB)
	IF(KP.EQ.0)GO TO 119
118	IBAR(KB)=NBAR(KB)
CC119	DO 112 KB=2,50,2
CC112	IF(IBAR(KB).EQ.0)GO TO 113
C ADDS UP BARS
119	IF(IBAR(KB-2).NE.KT)GO TO 606
C GO BACK IF MISMATCH
	MB=0
	LB=1
	KA=1
	RPG=0
114	KKT=IBAR(KA)-MB
	NB=MB+1
	MB=IBAR(KA)
C RESET MB FOR NEXT TIME AROUND
	MPG=IBAR(KA+1)
	KP=MPG/100
C GET NUM OF PAGES
	MPG=MPG-KP*100
	JT=MPG*KP
116	JTOT=0
	DO 125 KE=NB,KKT+NB-1
125	JTOT=JTOT+JBAR(KE)
	CALL BRJUGL(JBAR(NB),KKT,NBAR(LB),MBAR(NB),JRN(NB),PGTRN(NB)
	1,JTRN(NB))
	IF(KP.EQ.1)GO TO 122
C DOES ONLY ONE OR TWO PAGE UNITS
124	DO 123 KE=LB+JT+1,LB+MPG+1,-1   
123	NBAR(KE)=NBAR(KE-1)
	NBAR(LB+MPG)=0
	LB=LB+MPG+1
122	KA=KA+2
	LB=1+LB+MPG
C  UPDATE NBAR COUNTER
1111	RPG=RPG+KP
	IF(KA.LT.KB)GO TO 114
	JT=MPG*RPG
CC	KA=0
	JTOT=LTOT
	GO TO 605

911	DO 117 K=50,1,-1
	KP=NBAR(K)
	KA=KA+KP
117	IF(KP.EQ.0.AND.KA.EQ.0)KL=K
	IF(KA.NE.KT)GO TO 606
C  MISMATCH!
	N=26-2*MOD(KL-1,12)
	IF(N.EQ.26)N=0
C  TO SPACE OUT STAVES VERTICALLY  ???
	DO 121 K=1,50
121	IF(NBAR(K).EQ.0)GO TO 120
120	MPG=K-1

CC11	SPG=PGLNTH/MPG
C  MPG=NUM OF BRACES PER PAGE.
C  SPG IS SPACE TO BE SET ABOVE STAFF 0
11	IF(KPG.NE.0)MPG=KPG
	CALL WRTPAG
700	IF(T.LT.-1)GO TO 609
C TYPE -2 TO GET BACK 'PAGE TURN' MODE
	TYPE 701
	TYPE 90,KT
	GO TO 610
701	FORMAT(' FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE'//
	1' A SINGLE NUMBER = NUMB. OF LINES ONLY.'//
	1' TYPE X,Y FOR X PAGES, Y LINES PER PAGE.'/
	1' 2,5=2 PAGES, 5 LINES, 4,10=4 PAGES, 10 LINES, ETC.'//
	1' M1,M2,...0  N1,N2,...0  = ZEROS ARE PAGE MARKS.'/
	1' N''S ARE NUMB. OF BARS PER LINE.'//
	1' N X0A  M Y0B  K Z0C  ETC. = '/
	1' A = NUM OF LINES/PAGE, N=NUMB OF BARS/PAGE(S),
	1  X =NUMB OF PAGES.'/
	1' EXAMPLE: 40 208  = 8 LINES/PAGE, 40 BARS ON 2 PAGES.'//
	1' NEGATIVE NUMBS IN BAR LIST ARE POSSIBLE PAGE TURN POINTS.'/
	1'    TYPE -2 TO RETURN TO "PAGE TURN" MODE.'/)
CCC	1' 0 N = EXITS WITH N" SPACE BETWEEN STAVES.'//
	END